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

⟦08204da0f⟧ TextFile

    Length: 9811 (0x2653)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Bounded_String;
with Class_Integer;  
with Class_String;
with Message;
with String_Utilities;
with Text_Io;

package body Class_Pen_Y is
    function Send (This_Message : Message.Unary; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Rentre_Chez_Toi, Ligne_Suivante, Ton_X, Ton_Y,
                           Ta_Fonte, Duplique, Detruit, En_Texte);

        Token : E_Message;

        package Bs renames Bounded_String;

        An_Object : Object.Reference;
    begin
        Token := E_Message'Value (Bs.Image
                                     (Message.Get (Name_From => This_Message)));
        case Token is
            when Rentre_Chez_Toi =>
                Table (Object.Get (To)).X := 0;
                Table (Object.Get (To)).Y := 0;
                return To;

            when Ligne_Suivante =>
                Table (Object.Get (To)).X := 0;
                Table (Object.Get (To)).Y :=
                   Table (Object.Get (To)).Y +
                      16 * Easy_Y.Fonts'Pos (Table (Object.Get (To)).Taille);
                return Class_Integer.Create (Object.Index
                                                (Table (Object.Get (To)).Y));

            when Ton_X =>
                return Class_Integer.Create (Object.Index
                                                (Table (Object.Get (To)).X));

            when Ton_Y =>
                return Class_Integer.Create (Object.Index
                                                (Table (Object.Get (To)).Y));

            when Ta_Fonte =>
                return Class_String.Create
                          (Easy_Y.Fonts'Image (Table (Object.Get (To)).Taille));

            when Duplique =>
                An_Object := Class_Pen_Y.Create;  
                Table (Object.Get (An_Object)).X := Table (Object.Get (To)).X;
                Table (Object.Get (An_Object)).Y := Table (Object.Get (To)).Y;
                return An_Object;

            when Detruit =>
                return Object.Void_Reference;

            when En_Texte =>
                Text_Io.Put ("Objet Pen (");
                Text_Io.New_Line;

                Text_Io.Put ("    Classe =>");
                Text_Io.Put (Object.E_Class'Image (Object.Get (To)));
                Text_Io.New_Line;

                Text_Io.Put ("    Objet =>");
                Text_Io.Put (Object.Index'Image (Object.Get (To)));
                Text_Io.New_Line;

                Text_Io.Put ("        X =>");
                Text_Io.Put (Integer'Image (Table (Object.Get (To)).X));
                Text_Io.New_Line;

                Text_Io.Put ("        Y =>");
                Text_Io.Put (Integer'Image (Table (Object.Get (To)).Y));
                Text_Io.New_Line;

                Text_Io.Put ("        Fonte =>");
                Text_Io.Put (Easy_Y.Fonts'Image
                                (Table (Object.Get (To)).Taille));
                Text_Io.New_Line;

                Text_Io.Put (" )");
                Text_Io.New_Line (2);
                return Object.Void_Reference;

        end case;
    exception
        when Constraint_Error =>
            return Object.Void_Reference;
    end Send;


    function Send (This_Message : Message.Binary; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Avance, Ecrit, Fonte);

        An_Object : Object.Reference;
        A_Tiny_String : Object.Tiny_String;
        The_Message : Message.Binary := This_Message;

        Token : E_Message;

        package Bs renames Bounded_String;

        use Object;

        Pas : Object.Index;
    begin
        Token := E_Message'Value (Bs.Image
                                     (Message.Get (Name_From => The_Message)));

        case Token is
            when Avance =>
                An_Object := Message.Get (The_Message);
                A_Tiny_String := Message.Get (The_Message);

                if Object.Get (An_Object) = E_Class (Integer_Class) then
                    Pas := Object.Get (An_Object);
                    Table (Object.Get (To)).X :=
                       Table (Object.Get (To)).X + Integer (Pas);
                else
                    null;
                end if;
                return To;

            when Ecrit =>
                An_Object := Message.Get (The_Message);
                A_Tiny_String := Class_String.Get (Object.Get (An_Object));

                if Object.Get (An_Object) = Object.E_Class (String_Class) then
                    Easy_Y.Move_To (X => Easy_Y.Coordinate
                                            (Table (Object.Get (To)).X),
                                    Y => Easy_Y.Coordinate
                                            (Table (Object.Get (To)).Y));
                    Easy_Y.Set_Font (To => Table (Object.Get (To)).Taille);
                    Easy_Y.Draw_String (The_String => Bs.Image (A_Tiny_String));
                else
                    null;
                end if;
                return Object.Void_Reference;

            when Fonte =>
                An_Object := Message.Get (The_Message);
                A_Tiny_String := Message.Get (The_Message);

                if Object.Get (An_Object) = E_Class (Integer_Class) then
                    Table (Object.Get (To)).Taille :=
                       Easy_Y.Fonts'Val (Object.Get (An_Object));
                else
                    null;
                end if;
                return To;

        end case;

    exception
        when Constraint_Error =>
            return Object.Void_Reference;
    end Send;


    function Send (This_Message : Message.Keyword; To : Object.Reference)
                  return Object.Reference is
        type E_Message is (Va_En_X, Y);

        An_Object : Object.Reference;
        A_Tiny_String : Object.Tiny_String;
        The_Message : Message.Keyword := This_Message;

        Token : E_Message;

        package Bs renames Bounded_String;

        use Object;

        Pas : Object.Index;
    begin
        Token := E_Message'Value (Bs.Image (Message.Get (The_Message)));

        case Token is
            when Va_En_X =>
                An_Object := Message.Get (The_Message);
                A_Tiny_String := Message.Get (The_Message);

                if Object.Get (An_Object) = E_Class (Integer_Class) then
                    Pas := Object.Get (An_Object);
                    Table (Object.Get (To)).X := Integer (Pas);

                    Message.Next (The_Message);
                    if not Message.Is_Done (The_Message) then

                        An_Object := Message.Get (The_Message);
                        A_Tiny_String := Message.Get (The_Message);

                        if Bs.Image (A_Tiny_String) = "Y" then
                            if Object.Get (An_Object) =
                               E_Class (Integer_Class) then
                                Pas := Object.Get (An_Object);
                                Table (Object.Get (To)).Y := Integer (Pas);
                            else
                                null;
                            end if;
                        end if;
                    else
                        null;
                    end if;
                end if;
                return To;

            when Y =>
                An_Object := Message.Get (The_Message);
                A_Tiny_String := Message.Get (The_Message);

                if Object.Get (An_Object) = E_Class (Integer_Class) then
                    Pas := Object.Get (An_Object);
                    Table (Object.Get (To)).X := Integer (Pas);

                    Message.Next (The_Message);
                    if not Message.Is_Done (The_Message) then

                        An_Object := Message.Get (Argument_From => The_Message);
                        A_Tiny_String := Message.Get (Name_From => The_Message);

                        if Bs.Image (A_Tiny_String) = "Va_En_X" then
                            if Object.Get (An_Object) =
                               E_Class (Integer_Class) then
                                Pas := Object.Get (An_Object);
                                Table (Object.Get (To)).Y := Integer (Pas);
                            else
                                null;
                            end if;
                        end if;
                    else
                        null;
                    end if;
                end if;
                return To;

        end case;

    exception
        when Constraint_Error =>
            return Object.Void_Reference;
    end Send;


    function Create return Object.Reference is
        use Object;
    begin
        Last := Last + 1;
        return Object.Create (Class => Object.Pen_Class, Object => Last);
    end Create;


    function Image (An_Object : Object.Reference) return Object.Tiny_String is
        use Object;
        Chaine : Object.Tiny_String;
        Valeur : Object.Index;
    begin
        Valeur := Object.Get (An_Object);
        Bounded_String.Copy (Chaine, String_Utilities.Number_To_String
                                        (Integer (Valeur)));
        return Chaine;
    end Image;


    function Value (Chaine : Object.Tiny_String) return Object.Reference is
        An_Object : Object.Reference;
        Bool : Boolean;
        Entier : Integer;
    begin
        String_Utilities.String_To_Number
           (Source => Bounded_String.Image (V => Chaine),
            Target => Entier,
            Worked => Bool);
        Object.Put (Object.Integer_Class, An_Object);
        Object.Put (Object.Index (Entier), An_Object);
        return An_Object;
    end Value;


    function How_Many return Object.Index is
    begin
        return Last;
    end How_Many;

end Class_Pen_Y;